Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOPTC0

PSOPTC0.m

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