- PSOPTC0 ;AITC/PD - Patient Billing Comments;9/5/2017
- ;;7.0;OUTPATIENT PHARMACY;**482,704**;DEC 1997;Build 16
- ;
- EN ; Menu Option Entry Point
- ;
- I '$D(^XUSEC("PSO EPHARMACY SITE MANAGER",DUZ)) W !,$C(7),"Requires Pharmacy Key (PSO EPHARMACY SITE MANAGER) !" Q
- ;
- N DIC,DTOUT,X,Y
- ;
- K PSOPTC
- ;
- ;Division selection
- I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
- ;
- ;Patient selection
- W !!
- S DIC=2,DIC(0)="QEAM"
- D ^DIC
- G EXIT:((Y<0)!($D(DTOUT)))
- S PSOPTC("DFN")=+Y
- ;
- D EN^VALM("PSO PATIENT COMMENT")
- ;
- Q
- ;
- HDR ; Header
- ;
- N DFN,H1,H2,VA,VADM
- ;
- S DFN=$G(PSOPTC("DFN"))
- I 'DFN G EXIT
- D DEM^VADPT
- S H1=$$LJ^XLFSTR("Patient: "_$E($G(VADM(1)),1,30)_" ("_$G(VA("BID"))_")",48)
- S $E(H1,57)=$$LJ^XLFSTR("DOB: "_$$FMTE^XLFDT($P($G(VADM(3)),U,1),"2Z")_" ("_$G(VADM(4))_")",22)
- S H2=$$LJ^XLFSTR("Birth Sex: "_$P($G(VADM(5)),U,1),8)
- S $E(H2,32)="Self-Identified Gender: "_$E($P($G(VADM(14,5)),U,1),1,24)
- ;
- S VALMHDR(1)=H1
- S VALMHDR(2)=H2
- S VALMHDR(3)="# STATUS DATE/TIME USER"
- Q
- ;
- INIT ;
- ;
- D CLEAN^VALM10
- D BUILD
- Q
- ;
- BUILD ; Build ListMan Screen
- ;
- ; PSODFN = Patient Record ID
- ; PSOPC = PATIENT COMMENT sub-file (#55.17) Record ID
- ;
- N DIWL,DIWR,PSOCNT,PSOCOM,PSOCOMMENT,PSODATA,PSODATE,PSODATE1
- N PSODFN,PSOLINE,PSOPC,PSOSTATUS,PSOSTR,PSOUSER,PSOY
- ;
- S PSOLINE=0
- S PSOCNT=0
- S PSODFN=$G(PSOPTC("DFN"))
- I 'PSODFN G EXIT
- ;
- ; Loop through the PATIENT COMMENT sub-file (#55.17) in reverse
- ; chronological order.
- S PSODATE=""
- F S PSODATE=$O(^PS(55,PSODFN,"PC","B",PSODATE),-1) Q:PSODATE="" D
- . S PSOPC=$O(^PS(55,PSODFN,"PC","B",PSODATE,""))
- . K PSODATA
- . D GETS^DIQ(55.17,PSOPC_","_PSODFN_",",".01;1;2;3","E","PSODATA")
- . S PSODATE1=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",.01,"E"))
- . S PSOUSER=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",1,"E"))
- . S PSOSTATUS=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",2,"E"))
- . S PSOCOMMENT=$G(PSODATA(55.17,PSOPC_","_PSODFN_",",3,"E"))
- . S PSOCNT=PSOCNT+1
- . S PSOSTR=PSOCNT_" "_$E(PSOSTATUS)_" "_PSODATE1_" "_PSOUSER
- . S PSOLINE=PSOLINE+1
- . S @VALMAR@("IDX",PSOCNT,PSOPC)=""
- . D SET^VALM10(PSOLINE,PSOSTR,"")
- . ; Use ^DIWP to format comment into lines no greater than 78 characters
- . ; with logical breaks between words.
- . K ^UTILITY($J,"W")
- . S X=PSOCOMMENT,DIWL=1,DIWR=78
- . D ^DIWP
- . F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
- . . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
- . . S PSOLINE=PSOLINE+1
- . . D SET^VALM10(PSOLINE," "_PSOCOM,"")
- . K ^UTILITY($J,"W")
- ;
- S VALMCNT=PSOLINE
- ;
- Q
- ;
- ADD ; Add Patient Comment
- ;
- N PSO55,PSOCOM
- ;
- D FULL^VALM1
- S PSOCOM=$$COMMENT("Comment: ",150)
- ; Comment not confirmed or user entered ^ to Exit
- I $L(PSOCOM)=0!(PSOCOM["^") S VALMBCK="R" Q
- S PSO55=$G(PSOPTC("DFN"))
- ; Valid comment entered - Create new multiple record
- D ADDPC(PSOCOM,PSO55)
- D INIT
- S VALMBCK="R"
- ;
- Q
- ;
- ;Enter a comment
- ;PSOTR -prompt string
- ;PSMLEN -maxlen
- ;returns:
- ; "^" - if user chose to quit
- ; "" - nothing entered or input has been discarded
- ; otherwise - comment's text
- N DIR,DTOUT,DUOUT,PSQ
- I '$D(PSOTR) S PSOTR="Comment "
- I '$D(PSMLEN) S PSMLEN=150
- S DIR(0)="FA^1:150"
- S DIR("A")=PSOTR
- S DIR("?")="Enter a free text comment up to 150 characters long."
- S PSQ=0
- F D Q:+PSQ'=0
- . W ! D ^DIR
- . I $D(DUOUT)!($D(DTOUT)) S PSQ=-1 Q
- . I $L(Y)'>PSMLEN S PSQ=1 Q
- . W !!,"Enter a free text comment up to 150 characters long.",!
- . S DIR("B")=$E(Y,1,PSMLEN)
- Q:PSQ<0 "^"
- Q:$L(Y)=0 ""
- S PSQ=$$YESNO^PSOREJP3("Are you sure Y/N")
- I PSQ=-1 Q "^"
- I PSQ=0 Q ""
- Q Y
- ;
- ;
- ADDPC(PSOCOM,PSO55) ; Add new multiple record for Patient Comment
- ;
- N PSO200,PSOAR,PSOFILE,PSOIEN,PSONOW,PSOPC
- ;
- ; Create the Patient Comment multiple
- S PSOFILE=55.17
- D NOW^%DTC
- S PSONOW=%
- S PSOAR(1,PSOFILE,"+1,"_PSO55_",",.01)=PSONOW
- D UPDATE^DIE("","PSOAR(1)") K PSOAR
- ;
- ; Populate the data into the Patient Comment multiple
- S PSO200=DUZ
- S PSOPC=$O(^PS(55,PSO55,"PC","B",PSONOW,""))
- S PSOIEN=PSOPC_","_PSO55_","
- S PSOAR(PSOFILE,PSOIEN,1)=PSO200
- S PSOAR(PSOFILE,PSOIEN,2)="Y"
- S PSOAR(PSOFILE,PSOIEN,3)=PSOCOM
- D FILE^DIE(,"PSOAR") K PSOAR
- ;
- ; Add Patient Comment History
- D ADDPCH(PSO55,PSOPC,PSONOW,1)
- ;
- Q
- ;
- ADDPCH(PSO55,PSOPC,PSONOW,PSOACT) ; Add new multiple record for Patient Comment History
- ;
- N PSO200,PSOAR,PSOFILE,PSOIEN,PSOPCH
- ;
- ; Create the Patient Comment History multiple
- S PSOFILE=55.174
- S PSO200=DUZ
- S PSOAR(1,PSOFILE,"+1,"_PSOPC_","_PSO55_",",.01)=PSONOW
- D UPDATE^DIE("","PSOAR(1)")
- K PSOAR
- ;
- ; Populate the data into the Patient Comment History multiple
- S PSOPCH=$O(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,""))
- S PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
- S PSOAR(PSOFILE,PSOIEN,1)=PSO200
- S PSOAR(PSOFILE,PSOIEN,2)=PSOACT
- D FILE^DIE(,"PSOAR") K PSOAR
- ;
- Q
- ;
- ACT ; Activate / Inactivate Patient Comment
- ;
- ; ACT serves as a toggle for Activating and Inactivating comments.
- ; Upon selection of this action, the user will be prompted for
- ; the line to Activate/Inactivate. The comment will be redisplayed
- ; to the user. A confirmation prompt will appear. Upon confirmation,
- ; the value will be updated and the display refreshed.
- ; If the user confirmed to change the status of the comment, a history
- ; record will be filed.
- ;
- N DIWL,DIWR,PSO55,PSOACT,PSOACT1,PSOAR,PSOCOM,PSODATA,PSOFILE
- N PSOLINE,PSOIEN,PSONOW,PSONOWH,PSOPC,PSOY,PSOYESNO
- ;
- ; Get record id (#55.17) for selected entry
- S PSOPC=$$SELECT(.PSOLINE)
- ;
- I PSOPC="^" S VALMBCK="R" Q
- ;
- S PSOFILE=55.17
- S PSO55=PSOPTC("DFN")
- K PSODATA
- S PSOIEN=PSOPC_","_PSO55_","
- D GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
- S PSONOW=$G(PSODATA(55.17,PSOIEN,.01,"I"))
- S PSOACT="Activate"
- S PSOACT1=$G(PSODATA(55.17,PSOIEN,2,"I"))
- I PSOACT1="Y" S PSOACT="Inactivate"
- W !,PSOACT_" Comment # "_PSOLINE_":"
- I $L($G(PSODATA(55.17,PSOIEN,3,"I")))>78 D
- . K ^UTILITY($J,"W")
- . S X=PSODATA(55.17,PSOIEN,3,"I"),DIWL=1,DIWR=78
- . D ^DIWP
- . F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
- . . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
- . . W !," "_PSOCOM
- . K ^UTILITY($J,"W")
- E W !," "_PSODATA(55.17,PSOIEN,3,"I")
- ;
- S PSOYESNO=$$YESNO^PSOREJP3("Are you sure Y/N")
- I PSOYESNO=-1 G ACTX
- ;
- I PSOYESNO=1 D
- . S PSOAR(PSOFILE,PSOIEN,2)="N"
- . I PSOACT1="N" S PSOAR(PSOFILE,PSOIEN,2)="Y"
- . D FILE^DIE(,"PSOAR") K PSOAR
- . ;
- . ; Add Patient Comment History
- . D NOW^%DTC
- . S PSONOWH=%
- . I PSOACT1="Y" D ADDPCH(PSO55,PSOPC,PSONOWH,3)
- . I PSOACT1="N" D ADDPCH(PSO55,PSOPC,PSONOWH,2)
- ;
- ACTX ;
- ;
- D INIT
- S VALMBCK="R"
- ;
- Q
- ;
- HIST ; Patient Comment History
- ;
- ; HIST provides a historical view of any Patient Comment.
- ; The user will be prompted to select a Patient Comment. The
- ; comment will be redisplayed to the user. A listing of the
- ; comment's history will display in reverse chronological order.
- ; The values in this listing will include ADD, ACTIVATE and
- ; INACTIVATE. The date/time and user for each historical
- ; update will display.
- ;
- N DIWL,DIWR,PSO55,PSOCOM,PSODATA,PSOIEN,PSOLINE
- N PSONOW,PSOPC,PSOPCH,PSOY
- ;
- S PSOPC=$$SELECT(.PSOLINE)
- ;
- I PSOPC="^" S VALMBCK="R" Q
- ;
- S PSO55=PSOPTC("DFN")
- ;
- W !
- S PSOIEN=PSOPC_","_PSO55_","
- K PSODATA
- D GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
- I $L($G(PSODATA(55.17,PSOIEN,3,"I")))>78 D
- . K ^UTILITY($J,"W")
- . S X=PSODATA(55.17,PSOIEN,3,"I"),DIWL=1,DIWR=78
- . D ^DIWP
- . F PSOY=1:1 Q:('$D(^UTILITY($J,"W",1,PSOY,0))) D
- . . S PSOCOM=$G(^UTILITY($J,"W",1,PSOY,0))
- . . W !," "_PSOCOM
- . K ^UTILITY($J,"W")
- E W !," "_PSODATA(55.17,PSOIEN,3,"I")
- W !
- ;
- S PSONOW=""
- F S PSONOW=$O(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW),-1) Q:PSONOW="" D
- . S PSOPCH=""
- . S PSOPCH=$O(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,PSOPCH))
- . S PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
- . K PSODATA
- . D GETS^DIQ(55.174,PSOIEN,".01;1;2","E","PSODATA")
- . W !,$G(PSODATA(55.174,PSOIEN,2,"E"))
- . W ?15,$G(PSODATA(55.174,PSOIEN,.01,"E"))
- . W ?45,$G(PSODATA(55.174,PSOIEN,1,"E"))
- ;
- D WAIT^VALM1
- ;
- D INIT
- S VALMBCK="R"
- ;
- Q
- ;
- SELECT(PSOLINE) ; Select Line from List View
- ;
- N DIR,DIRUT,PSOMAX,Y
- ;
- D FULL^VALM1
- ;
- I '$D(^TMP("PSOPTC0",$J)) D Q "^"
- . W !!,"No Patient Comments available for selection."
- . D WAIT^VALM1
- ;
- S PSOMAX=$O(^TMP("PSOPTC0",$J,"IDX",""),-1)
- ;
- I PSOMAX=1 S PSOLINE=1 Q $O(^TMP("PSOPTC0",$J,"IDX",PSOLINE,""))
- ;
- W !
- S DIR(0)="N^1:"_PSOMAX
- S DIR("A")="Line"
- I PSOMAX=1 S DIR("B")=PSOMAX
- D ^DIR
- ;
- I $D(DIRUT) Q "^"
- S PSOLINE=Y
- ;
- Q $O(^TMP("PSOPTC0",$J,"IDX",PSOLINE,""))
- ;
- HELP ;
- ;
- Q
- ;
- EXIT ;
- ;
- K ^TMP("PSOPTC0",$J),PSOPTC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPTC0 8889 printed Jan 18, 2025@03:34:18 Page 2
- PSOPTC0 ;AITC/PD - Patient Billing Comments;9/5/2017
- +1 ;;7.0;OUTPATIENT PHARMACY;**482,704**;DEC 1997;Build 16
- +2 ;
- EN ; Menu Option Entry Point
- +1 ;
- +2 IF '$DATA(^XUSEC("PSO EPHARMACY SITE MANAGER",DUZ))
- WRITE !,$CHAR(7),"Requires Pharmacy Key (PSO EPHARMACY SITE MANAGER) !"
- QUIT
- +3 ;
- +4 NEW DIC,DTOUT,X,Y
- +5 ;
- +6 KILL PSOPTC
- +7 ;
- +8 ;Division selection
- +9 IF '$GET(PSOSITE)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
- GOTO EXIT
- +10 ;
- +11 ;Patient selection
- +12 WRITE !!
- +13 SET DIC=2
- SET DIC(0)="QEAM"
- +14 DO ^DIC
- +15 if ((Y<0)!($DATA(DTOUT)))
- GOTO EXIT
- +16 SET PSOPTC("DFN")=+Y
- +17 ;
- +18 DO EN^VALM("PSO PATIENT COMMENT")
- +19 ;
- +20 QUIT
- +21 ;
- HDR ; Header
- +1 ;
- +2 NEW DFN,H1,H2,VA,VADM
- +3 ;
- +4 SET DFN=$GET(PSOPTC("DFN"))
- +5 IF 'DFN
- GOTO EXIT
- +6 DO DEM^VADPT
- +7 SET H1=$$LJ^XLFSTR("Patient: "_$EXTRACT($GET(VADM(1)),1,30)_" ("_$GET(VA("BID"))_")",48)
- +8 SET $EXTRACT(H1,57)=$$LJ^XLFSTR("DOB: "_$$FMTE^XLFDT($PIECE($GET(VADM(3)),U,1),"2Z")_" ("_$GET(VADM(4))_")",22)
- +9 SET H2=$$LJ^XLFSTR("Birth Sex: "_$PIECE($GET(VADM(5)),U,1),8)
- +10 SET $EXTRACT(H2,32)="Self-Identified Gender: "_$EXTRACT($PIECE($GET(VADM(14,5)),U,1),1,24)
- +11 ;
- +12 SET VALMHDR(1)=H1
- +13 SET VALMHDR(2)=H2
- +14 SET VALMHDR(3)="# STATUS DATE/TIME USER"
- +15 QUIT
- +16 ;
- INIT ;
- +1 ;
- +2 DO CLEAN^VALM10
- +3 DO BUILD
- +4 QUIT
- +5 ;
- BUILD ; Build ListMan Screen
- +1 ;
- +2 ; PSODFN = Patient Record ID
- +3 ; PSOPC = PATIENT COMMENT sub-file (#55.17) Record ID
- +4 ;
- +5 NEW DIWL,DIWR,PSOCNT,PSOCOM,PSOCOMMENT,PSODATA,PSODATE,PSODATE1
- +6 NEW PSODFN,PSOLINE,PSOPC,PSOSTATUS,PSOSTR,PSOUSER,PSOY
- +7 ;
- +8 SET PSOLINE=0
- +9 SET PSOCNT=0
- +10 SET PSODFN=$GET(PSOPTC("DFN"))
- +11 IF 'PSODFN
- GOTO EXIT
- +12 ;
- +13 ; Loop through the PATIENT COMMENT sub-file (#55.17) in reverse
- +14 ; chronological order.
- +15 SET PSODATE=""
- +16 FOR
- SET PSODATE=$ORDER(^PS(55,PSODFN,"PC","B",PSODATE),-1)
- if PSODATE=""
- QUIT
- Begin DoDot:1
- +17 SET PSOPC=$ORDER(^PS(55,PSODFN,"PC","B",PSODATE,""))
- +18 KILL PSODATA
- +19 DO GETS^DIQ(55.17,PSOPC_","_PSODFN_",",".01;1;2;3","E","PSODATA")
- +20 SET PSODATE1=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",.01,"E"))
- +21 SET PSOUSER=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",1,"E"))
- +22 SET PSOSTATUS=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",2,"E"))
- +23 SET PSOCOMMENT=$GET(PSODATA(55.17,PSOPC_","_PSODFN_",",3,"E"))
- +24 SET PSOCNT=PSOCNT+1
- +25 SET PSOSTR=PSOCNT_" "_$EXTRACT(PSOSTATUS)_" "_PSODATE1_" "_PSOUSER
- +26 SET PSOLINE=PSOLINE+1
- +27 SET @VALMAR@("IDX",PSOCNT,PSOPC)=""
- +28 DO SET^VALM10(PSOLINE,PSOSTR,"")
- +29 ; Use ^DIWP to format comment into lines no greater than 78 characters
- +30 ; with logical breaks between words.
- +31 KILL ^UTILITY($JOB,"W")
- +32 SET X=PSOCOMMENT
- SET DIWL=1
- SET DIWR=78
- +33 DO ^DIWP
- +34 FOR PSOY=1:1
- if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
- QUIT
- Begin DoDot:2
- +35 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
- +36 SET PSOLINE=PSOLINE+1
- +37 DO SET^VALM10(PSOLINE," "_PSOCOM,"")
- End DoDot:2
- +38 KILL ^UTILITY($JOB,"W")
- End DoDot:1
- +39 ;
- +40 SET VALMCNT=PSOLINE
- +41 ;
- +42 QUIT
- +43 ;
- ADD ; Add Patient Comment
- +1 ;
- +2 NEW PSO55,PSOCOM
- +3 ;
- +4 DO FULL^VALM1
- +5 SET PSOCOM=$$COMMENT("Comment: ",150)
- +6 ; Comment not confirmed or user entered ^ to Exit
- +7 IF $LENGTH(PSOCOM)=0!(PSOCOM["^")
- SET VALMBCK="R"
- QUIT
- +8 SET PSO55=$GET(PSOPTC("DFN"))
- +9 ; Valid comment entered - Create new multiple record
- +10 DO ADDPC(PSOCOM,PSO55)
- +11 DO INIT
- +12 SET VALMBCK="R"
- +13 ;
- +14 QUIT
- +15 ;
- +16 ;Enter a comment
- +17 ;PSOTR -prompt string
- +18 ;PSMLEN -maxlen
- +19 ;returns:
- +20 ; "^" - if user chose to quit
- +21 ; "" - nothing entered or input has been discarded
- +22 ; otherwise - comment's text
- +1 NEW DIR,DTOUT,DUOUT,PSQ
- +2 IF '$DATA(PSOTR)
- SET PSOTR="Comment "
- +3 IF '$DATA(PSMLEN)
- SET PSMLEN=150
- +4 SET DIR(0)="FA^1:150"
- +5 SET DIR("A")=PSOTR
- +6 SET DIR("?")="Enter a free text comment up to 150 characters long."
- +7 SET PSQ=0
- +8 FOR
- Begin DoDot:1
- +9 WRITE !
- DO ^DIR
- +10 IF $DATA(DUOUT)!($DATA(DTOUT))
- SET PSQ=-1
- QUIT
- +11 IF $LENGTH(Y)'>PSMLEN
- SET PSQ=1
- QUIT
- +12 WRITE !!,"Enter a free text comment up to 150 characters long.",!
- +13 SET DIR("B")=$EXTRACT(Y,1,PSMLEN)
- End DoDot:1
- if +PSQ'=0
- QUIT
- +14 if PSQ<0
- QUIT "^"
- +15 if $LENGTH(Y)=0
- QUIT ""
- +16 SET PSQ=$$YESNO^PSOREJP3("Are you sure Y/N")
- +17 IF PSQ=-1
- QUIT "^"
- +18 IF PSQ=0
- QUIT ""
- +19 QUIT Y
- +20 ;
- +21 ;
- ADDPC(PSOCOM,PSO55) ; Add new multiple record for Patient Comment
- +1 ;
- +2 NEW PSO200,PSOAR,PSOFILE,PSOIEN,PSONOW,PSOPC
- +3 ;
- +4 ; Create the Patient Comment multiple
- +5 SET PSOFILE=55.17
- +6 DO NOW^%DTC
- +7 SET PSONOW=%
- +8 SET PSOAR(1,PSOFILE,"+1,"_PSO55_",",.01)=PSONOW
- +9 DO UPDATE^DIE("","PSOAR(1)")
- KILL PSOAR
- +10 ;
- +11 ; Populate the data into the Patient Comment multiple
- +12 SET PSO200=DUZ
- +13 SET PSOPC=$ORDER(^PS(55,PSO55,"PC","B",PSONOW,""))
- +14 SET PSOIEN=PSOPC_","_PSO55_","
- +15 SET PSOAR(PSOFILE,PSOIEN,1)=PSO200
- +16 SET PSOAR(PSOFILE,PSOIEN,2)="Y"
- +17 SET PSOAR(PSOFILE,PSOIEN,3)=PSOCOM
- +18 DO FILE^DIE(,"PSOAR")
- KILL PSOAR
- +19 ;
- +20 ; Add Patient Comment History
- +21 DO ADDPCH(PSO55,PSOPC,PSONOW,1)
- +22 ;
- +23 QUIT
- +24 ;
- ADDPCH(PSO55,PSOPC,PSONOW,PSOACT) ; Add new multiple record for Patient Comment History
- +1 ;
- +2 NEW PSO200,PSOAR,PSOFILE,PSOIEN,PSOPCH
- +3 ;
- +4 ; Create the Patient Comment History multiple
- +5 SET PSOFILE=55.174
- +6 SET PSO200=DUZ
- +7 SET PSOAR(1,PSOFILE,"+1,"_PSOPC_","_PSO55_",",.01)=PSONOW
- +8 DO UPDATE^DIE("","PSOAR(1)")
- +9 KILL PSOAR
- +10 ;
- +11 ; Populate the data into the Patient Comment History multiple
- +12 SET PSOPCH=$ORDER(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,""))
- +13 SET PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
- +14 SET PSOAR(PSOFILE,PSOIEN,1)=PSO200
- +15 SET PSOAR(PSOFILE,PSOIEN,2)=PSOACT
- +16 DO FILE^DIE(,"PSOAR")
- KILL PSOAR
- +17 ;
- +18 QUIT
- +19 ;
- ACT ; Activate / Inactivate Patient Comment
- +1 ;
- +2 ; ACT serves as a toggle for Activating and Inactivating comments.
- +3 ; Upon selection of this action, the user will be prompted for
- +4 ; the line to Activate/Inactivate. The comment will be redisplayed
- +5 ; to the user. A confirmation prompt will appear. Upon confirmation,
- +6 ; the value will be updated and the display refreshed.
- +7 ; If the user confirmed to change the status of the comment, a history
- +8 ; record will be filed.
- +9 ;
- +10 NEW DIWL,DIWR,PSO55,PSOACT,PSOACT1,PSOAR,PSOCOM,PSODATA,PSOFILE
- +11 NEW PSOLINE,PSOIEN,PSONOW,PSONOWH,PSOPC,PSOY,PSOYESNO
- +12 ;
- +13 ; Get record id (#55.17) for selected entry
- +14 SET PSOPC=$$SELECT(.PSOLINE)
- +15 ;
- +16 IF PSOPC="^"
- SET VALMBCK="R"
- QUIT
- +17 ;
- +18 SET PSOFILE=55.17
- +19 SET PSO55=PSOPTC("DFN")
- +20 KILL PSODATA
- +21 SET PSOIEN=PSOPC_","_PSO55_","
- +22 DO GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
- +23 SET PSONOW=$GET(PSODATA(55.17,PSOIEN,.01,"I"))
- +24 SET PSOACT="Activate"
- +25 SET PSOACT1=$GET(PSODATA(55.17,PSOIEN,2,"I"))
- +26 IF PSOACT1="Y"
- SET PSOACT="Inactivate"
- +27 WRITE !,PSOACT_" Comment # "_PSOLINE_":"
- +28 IF $LENGTH($GET(PSODATA(55.17,PSOIEN,3,"I")))>78
- Begin DoDot:1
- +29 KILL ^UTILITY($JOB,"W")
- +30 SET X=PSODATA(55.17,PSOIEN,3,"I")
- SET DIWL=1
- SET DIWR=78
- +31 DO ^DIWP
- +32 FOR PSOY=1:1
- if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
- QUIT
- Begin DoDot:2
- +33 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
- +34 WRITE !," "_PSOCOM
- End DoDot:2
- +35 KILL ^UTILITY($JOB,"W")
- End DoDot:1
- +36 IF '$TEST
- WRITE !," "_PSODATA(55.17,PSOIEN,3,"I")
- +37 ;
- +38 SET PSOYESNO=$$YESNO^PSOREJP3("Are you sure Y/N")
- +39 IF PSOYESNO=-1
- GOTO ACTX
- +40 ;
- +41 IF PSOYESNO=1
- Begin DoDot:1
- +42 SET PSOAR(PSOFILE,PSOIEN,2)="N"
- +43 IF PSOACT1="N"
- SET PSOAR(PSOFILE,PSOIEN,2)="Y"
- +44 DO FILE^DIE(,"PSOAR")
- KILL PSOAR
- +45 ;
- +46 ; Add Patient Comment History
- +47 DO NOW^%DTC
- +48 SET PSONOWH=%
- +49 IF PSOACT1="Y"
- DO ADDPCH(PSO55,PSOPC,PSONOWH,3)
- +50 IF PSOACT1="N"
- DO ADDPCH(PSO55,PSOPC,PSONOWH,2)
- End DoDot:1
- +51 ;
- ACTX ;
- +1 ;
- +2 DO INIT
- +3 SET VALMBCK="R"
- +4 ;
- +5 QUIT
- +6 ;
- HIST ; Patient Comment History
- +1 ;
- +2 ; HIST provides a historical view of any Patient Comment.
- +3 ; The user will be prompted to select a Patient Comment. The
- +4 ; comment will be redisplayed to the user. A listing of the
- +5 ; comment's history will display in reverse chronological order.
- +6 ; The values in this listing will include ADD, ACTIVATE and
- +7 ; INACTIVATE. The date/time and user for each historical
- +8 ; update will display.
- +9 ;
- +10 NEW DIWL,DIWR,PSO55,PSOCOM,PSODATA,PSOIEN,PSOLINE
- +11 NEW PSONOW,PSOPC,PSOPCH,PSOY
- +12 ;
- +13 SET PSOPC=$$SELECT(.PSOLINE)
- +14 ;
- +15 IF PSOPC="^"
- SET VALMBCK="R"
- QUIT
- +16 ;
- +17 SET PSO55=PSOPTC("DFN")
- +18 ;
- +19 WRITE !
- +20 SET PSOIEN=PSOPC_","_PSO55_","
- +21 KILL PSODATA
- +22 DO GETS^DIQ(55.17,PSOIEN,".01;2;3","I","PSODATA")
- +23 IF $LENGTH($GET(PSODATA(55.17,PSOIEN,3,"I")))>78
- Begin DoDot:1
- +24 KILL ^UTILITY($JOB,"W")
- +25 SET X=PSODATA(55.17,PSOIEN,3,"I")
- SET DIWL=1
- SET DIWR=78
- +26 DO ^DIWP
- +27 FOR PSOY=1:1
- if ('$DATA(^UTILITY($JOB,"W",1,PSOY,0)))
- QUIT
- Begin DoDot:2
- +28 SET PSOCOM=$GET(^UTILITY($JOB,"W",1,PSOY,0))
- +29 WRITE !," "_PSOCOM
- End DoDot:2
- +30 KILL ^UTILITY($JOB,"W")
- End DoDot:1
- +31 IF '$TEST
- WRITE !," "_PSODATA(55.17,PSOIEN,3,"I")
- +32 WRITE !
- +33 ;
- +34 SET PSONOW=""
- +35 FOR
- SET PSONOW=$ORDER(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW),-1)
- if PSONOW=""
- QUIT
- Begin DoDot:1
- +36 SET PSOPCH=""
- +37 SET PSOPCH=$ORDER(^PS(55,PSO55,"PC",PSOPC,"PCH","B",PSONOW,PSOPCH))
- +38 SET PSOIEN=PSOPCH_","_PSOPC_","_PSO55_","
- +39 KILL PSODATA
- +40 DO GETS^DIQ(55.174,PSOIEN,".01;1;2","E","PSODATA")
- +41 WRITE !,$GET(PSODATA(55.174,PSOIEN,2,"E"))
- +42 WRITE ?15,$GET(PSODATA(55.174,PSOIEN,.01,"E"))
- +43 WRITE ?45,$GET(PSODATA(55.174,PSOIEN,1,"E"))
- End DoDot:1
- +44 ;
- +45 DO WAIT^VALM1
- +46 ;
- +47 DO INIT
- +48 SET VALMBCK="R"
- +49 ;
- +50 QUIT
- +51 ;
- SELECT(PSOLINE) ; Select Line from List View
- +1 ;
- +2 NEW DIR,DIRUT,PSOMAX,Y
- +3 ;
- +4 DO FULL^VALM1
- +5 ;
- +6 IF '$DATA(^TMP("PSOPTC0",$JOB))
- Begin DoDot:1
- +7 WRITE !!,"No Patient Comments available for selection."
- +8 DO WAIT^VALM1
- End DoDot:1
- QUIT "^"
- +9 ;
- +10 SET PSOMAX=$ORDER(^TMP("PSOPTC0",$JOB,"IDX",""),-1)
- +11 ;
- +12 IF PSOMAX=1
- SET PSOLINE=1
- QUIT $ORDER(^TMP("PSOPTC0",$JOB,"IDX",PSOLINE,""))
- +13 ;
- +14 WRITE !
- +15 SET DIR(0)="N^1:"_PSOMAX
- +16 SET DIR("A")="Line"
- +17 IF PSOMAX=1
- SET DIR("B")=PSOMAX
- +18 DO ^DIR
- +19 ;
- +20 IF $DATA(DIRUT)
- QUIT "^"
- +21 SET PSOLINE=Y
- +22 ;
- +23 QUIT $ORDER(^TMP("PSOPTC0",$JOB,"IDX",PSOLINE,""))
- +24 ;
- HELP ;
- +1 ;
- +2 QUIT
- +3 ;
- EXIT ;
- +1 ;
- +2 KILL ^TMP("PSOPTC0",$JOB),PSOPTC
- +3 QUIT